home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1997 / HAM Radio 1997.iso / vcls / proptest / proptest.pas next >
Pascal/Delphi Source File  |  1996-04-08  |  4KB  |  172 lines
  1. unit Proptest;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   DsgnIntf,
  8.   Forms, Dialogs;
  9.  
  10. type
  11.     TA = class(TPersistent)
  12.     protected
  13.         FText : string;
  14.     published
  15.         property Text : string read FText write FText;
  16.     end;
  17.  
  18.     TB = class(TPersistent)
  19.     protected
  20.            FA : TA;
  21.         FArr : Array[0..9] of integer;
  22.         procedure SetA(AA : TA);
  23.         procedure SetArr(Index, AVal : integer);
  24.         function  GetArr(Index : integer) : Integer;
  25.         procedure DefineProperties(Filer: TFiler); override;
  26.         procedure WriteArr(Writer: TWriter);
  27.         procedure ReadArr(Reader: TReader);
  28.     public
  29.           constructor Create;
  30.         destructor  Destroy; override;
  31.         property Arr[Index : integer] : integer read GetArr write SetArr;
  32.     published
  33.         property A : TA read FA write SetA;
  34.     end;
  35.  
  36. type
  37.     TPropTest = class(TWinControl)
  38.       protected
  39.           FB : TB;
  40.         procedure SetB(AB : TB);
  41.       public
  42.           constructor Create(AOwner : TComponent); override;
  43.         destructor  Destroy; override;
  44.       published
  45.           property B : TB read FB write SetB;
  46.       end;
  47.  
  48.     TBProperty = class(TClassProperty)
  49.       public
  50.         procedure Edit; override;
  51.         function GetAttributes: TPropertyAttributes; override;
  52.       end;
  53.  
  54. procedure Register;
  55.  
  56. implementation
  57.  
  58. uses
  59.     ubdialog;
  60.  
  61. {========================================}
  62. procedure Register;
  63. begin
  64.   RegisterComponents('Tests', [TPropTest]);
  65.   RegisterPropertyEditor(TypeInfo(TB),nil,'',TBProperty);
  66. end;
  67.  
  68. {========================================}
  69. constructor TPropTest.Create(AOwner : TComponent);
  70. begin
  71.     inherited Create(AOwner);
  72.     FB := TB.Create;
  73. end;
  74.  
  75. {========================================}
  76. destructor TPropTest.Destroy;
  77. begin
  78.     FB.Free;
  79.     Inherited Destroy;
  80. end;
  81.  
  82.  
  83. {========================================}
  84. procedure TPropTest.SetB(AB : TB);
  85. begin
  86.     FB.Assign(AB);
  87. end;
  88.  
  89. {========================================}
  90. {========================================}
  91. constructor TB.Create;
  92. var
  93.     i : integer;
  94. begin
  95.     for i := 0 to 9 do
  96.         Arr[i] := i;
  97.     FA := TA.Create;
  98. end;
  99.  
  100. {========================================}
  101. destructor TB.Destroy;
  102. begin
  103.     FA.Free;
  104.     Inherited Destroy;
  105. end;
  106.  
  107. {========================================}
  108. procedure TB.SetA(AA : TA);
  109. begin
  110.     FA.Assign(AA);
  111. end;
  112.  
  113. {========================================}
  114. procedure TB.SetArr(Index, AVal : integer);
  115. begin
  116.     FArr[Index] := AVal;
  117. end;
  118.  
  119. {========================================}
  120. function  TB.GetArr(Index : integer) : Integer;
  121. begin
  122.     result := FArr[Index];
  123. end;
  124.  
  125. {========================================}
  126. procedure TB.DefineProperties(Filer: TFiler);
  127. begin
  128.       Filer.DefineProperty('Arr', ReadArr, WriteArr, True);
  129. end;
  130.  
  131. {========================================}
  132. procedure TB.WriteArr(Writer: TWriter);
  133. var
  134.     i : integer;
  135. begin
  136.     for i := 0 to 9 do
  137.           Writer.WriteInteger(Arr[i]);
  138. end;
  139.  
  140. {========================================}
  141. procedure TB.ReadArr(Reader: TReader);
  142. var
  143.     i : integer;
  144. begin
  145.     for i := 0 to 9 do
  146.           Arr[i] := Reader.ReadInteger;
  147. end;
  148.  
  149. {========================================}
  150. {========================================}
  151. procedure TBProperty.Edit;
  152. var
  153.       BDialog: TBDialog;
  154. begin
  155.       BDialog := TBDialog.Create(Application);
  156.       try
  157.         BDialog.B := TB(GetOrdValue);
  158.         BDialog.ShowModal;
  159.       finally
  160.         BDialog.Free;
  161.       end;
  162. end;
  163.  
  164. {========================================}
  165. function TBProperty.GetAttributes: TPropertyAttributes;
  166. begin
  167.   Result := [paDialog, paReadOnly];
  168. end;
  169.  
  170.  
  171. end.
  172.